perm filename POOLTY.PAS[TEX,DEK] blob
sn#716788 filedate 1983-06-26 generic text, type T, neo UTF8
{2:}{$D-,W+}PROGRAM POOLTYPE(POOLFILE,OUTPUT);LABEL 9999;TYPE{5:}
ASCIICODE=0..127;{:5}VAR{7:}XORD:ARRAY[CHAR]OF ASCIICODE;
XCHR:ARRAY[ASCIICODE]OF CHAR;{:7}{12:}K,L:0..127;M,N:CHAR;S:INTEGER;
{:12}{13:}COUNT:INTEGER;{:13}{18:}POOLFILE:PACKED FILE OF CHAR;
XSUM:BOOLEAN;{:18}PROCEDURE INITIALIZE;VAR{6:}I:0..127;{:6}BEGIN{8:}
XCHR[32]:=' ';XCHR[33]:='!';XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';
XCHR[37]:='%';XCHR[38]:='&';XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';
XCHR[42]:='*';XCHR[43]:='+';XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';
XCHR[47]:='/';XCHR[48]:='0';XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';
XCHR[52]:='4';XCHR[53]:='5';XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';
XCHR[57]:='9';XCHR[58]:=':';XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';
XCHR[62]:='>';XCHR[63]:='?';XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';
XCHR[67]:='C';XCHR[68]:='D';XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';
XCHR[72]:='H';XCHR[73]:='I';XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';
XCHR[77]:='M';XCHR[78]:='N';XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';
XCHR[82]:='R';XCHR[83]:='S';XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';
XCHR[87]:='W';XCHR[88]:='X';XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';
XCHR[92]:='\';XCHR[93]:=']';XCHR[94]:='↑';XCHR[95]:='_';XCHR[96]:='`';
XCHR[97]:='a';XCHR[98]:='b';XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';
XCHR[102]:='f';XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';
XCHR[106]:='j';XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';
XCHR[110]:='n';XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';
XCHR[114]:='r';XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';
XCHR[118]:='v';XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';
XCHR[122]:='z';XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';
XCHR[126]:='~';XCHR[0]:=' ';XCHR[127]:=' ';{:8}{10:}
FOR I:=1 TO 31 DO XCHR[I]:=CHR(I);XCHR[24]:=CHR(95);XCHR[26]:=CHR(27);
XCHR[27]:=CHR(126);{:10}{11:}FOR I:=0 TO 127 DO XORD[CHR(I)]:=127;
FOR I:=1 TO 126 DO XORD[XCHR[I]]:=I;{:11}{14:}COUNT:=0;{:14}END;{:2}
{15:}BEGIN INITIALIZE;{16:}FOR K:=0 TO 127 DO BEGIN WRITE(K:3,': "');
IF(K<32)AND({17:}K IN[0,9..13,27]{:17}
)THEN BEGIN WRITE(XCHR[94],XCHR[94],XCHR[K+64]);COUNT:=COUNT+2;
END ELSE IF K=127 THEN BEGIN WRITE(XCHR[94],XCHR[94],XCHR[63]);
COUNT:=COUNT+2;
END ELSE IF K=34 THEN WRITE(XCHR[K],XCHR[K])ELSE WRITE(XCHR[K]);
COUNT:=COUNT+1;WRITELN('"');END{:16};S:=128;{19:}RESET(POOLFILE);
XSUM:=FALSE;
IF EOF(POOLFILE)THEN BEGIN WRITELN('! I can''t read the POOL file.');
GOTO 9999;END;REPEAT{20:}
IF EOF(POOLFILE)THEN BEGIN WRITELN('! POOL file contained no check sum')
;GOTO 9999;END;READ(POOLFILE,M,N);
IF M<>'*'THEN BEGIN IF(XORD[M]<48)OR(XORD[M]>57)OR(XORD[N]<48)OR(XORD[N]
>57)THEN BEGIN WRITELN('! POOL line doesn''t begin with two digits');
GOTO 9999;END;L:=XORD[M]*10+XORD[N]-48*11;WRITE(S:3,': "');
COUNT:=COUNT+L;
FOR K:=1 TO L DO BEGIN IF EOLN(POOLFILE)THEN BEGIN WRITELN('"');
BEGIN WRITELN('! That POOL line was too short');GOTO 9999;END;END;
READ(POOLFILE,M);WRITE(XCHR[XORD[M]]);
IF XORD[M]=34 THEN WRITE(XCHR[34]);END;WRITELN('"');S:=S+1;
END ELSE XSUM:=TRUE;READLN(POOLFILE){:20};UNTIL XSUM;
IF NOT EOF(POOLFILE)THEN BEGIN WRITELN(
'! There''s junk after the check sum');GOTO 9999;END{:19};
WRITELN('(',COUNT:1,' characters in all.)');9999:END.{:15}